perm filename DPY.F4[LIB,LCS] blob sn#089348 filedate 1974-02-23 generic text, type T, neo UTF8
00001	C  LOAD WITH PCALL.FAI  --  'LIBRY' HAS LIST OF FILES.
00002	C  'P' REPLAYS; '+N' GOES TO NEXT;  '-N' BACKS UP.
00100	C  'ALL'  PLAYS ALL UNDER A COMPOSER HEADING.
00300		DIMENSION J(2000),NWK(21),INP(21)
00310		CALL TYPLOC(-250,-511)
00320		NX=' '
00400	1	FORMAT(' COMPOSER?  ',$)
00410	201	FORMAT(A1)
00500	2	FORMAT(A5)
00510	7	FORMAT(20A1,A5)
00515		NCNT=0
00520	C  LIBRY MUST PUT FILE NAME AT 21st SPACE.
00600	10	TYPE 1
00620		NUMX=0
00630		ACCEPT 2,NCMP
00640		REREAD 201,IX
00701		REREAD 200,NUM
00702		IF(IX.EQ.'+')GO TO 41
00705		IF(NCMP.EQ.' ')NCMP=NX
00707		IF(NCMP.EQ.' ')NCMP='BACH'
00708	C  FOR DEMO
00710		IF(NCMP.EQ.'P')GO TO 11
00712		IF(IX.EQ.'-')GO TO 14
00715		NX=NCMP
00717	9	CALL IFILE(1,'LIBRY')
00718		IF(IX.EQ.'-')GO TO 16
00720	3	READ(1,20,END=5)K,NM
00740		NCNT=NCNT+1
00760		IF(NM.NE.NX)GO TO 3
00800		TYPE 12
00900	12	FORMAT(' NAME OF WORK?  ',$)
00910	20	FORMAT(I,A5)
01000		ACCEPT 7,NWK
01100	13	FORMAT(I,20A1,1A5)
01110		JT=WDNM(NWK)
01115		NW=0
01120		IF(NWK(1).EQ.'A'.AND.NWK(2).EQ.'L'.AND.NWK(3).EQ.'L')NW='ALL'
01137	C  JT=NUMERICAL VALUE OF NAME OF WORK
01140	4	READ(1,13,END=5)K,INP
01142		NCNT=NCNT+1
01143		IF(NCNT.LT.NUMX)GO TO 4
01145		IF(IX.EQ.'+'.OR.NW.EQ.'ALL')GO TO 40
01147	C  TYPE 'N' FOR NEXT ITEM IN LIST.
01150		IT=WDNM(INP)
01160		IF(IT.NE.JT)GO TO 4
01170	C  GO BACK IF NOT FOUND
02000	40	NM=INP(21)
02100		CALL IFILE(21,NM)
06010		CALL DPYSET(1,J,2000)
06020		READ(21)K,(J(N),N=1,K+2)
06030		CALL ACCPOG(1)
06050		CALL DPYOUT(1)
06060	11	CALL PLAY(NM,1,3)
06065		IF(NW.EQ.'ALL')GO TO 4
06070		GO TO 10
06080	5	TYPE 6
06085		NCNT=0
06090		GO TO 10
06100	6	FORMAT(' NOT FOUND'/)
06110	14	IF(NUM.EQ.0)NUM=-1
06210		NCNT=NCNT+NUM
06300		GO TO 9
07000	16	DO 15 K=1,NCNT
07100	15	READ(1,13)IT,INP
07200		GO TO 40
07400	41	IF(NUM.EQ.0)NUM=1
07500		NUMX=NUM+NCNT
07600		GO TO 4
07650	200	FORMAT(I)
07700		END
09900	
10000	C  GIVES NUMERICAL VALUE TO LETTER STRING
10100		FUNCTION WDNM(I)
10200		DIMENSION I(1)
10300		N=0
10400		DO 1 K=1,20
10500		IF(I(K).EQ.' ')GO TO 1
10600		N=N+(I(K)-'A')/536870912
10700	1	CONTINUE
10800		WDNM=N
10900		END